NOFY023 - podzim 2021

Speciální teorie relativity

dlouhé auto v krátké garáži

Pavel Krtouš

Tento notebook obsahuje animaci dokumentující závislost současnosti na inerciální soustavě.

Před prohlížením animací je potřeba spustit blok definic níže. Je potřeba ho celý zvýraznit (např. kliknutím na druhou svislou linii na pravém okraji vedle nadpisu Definice) a spustit (pravý Enter či Shift+Enter). Po té je již možné animace používat (tj. není potřeba je všechny znovu spouštět). 
Notebook je připraven jako prezentace a je možné spustit prostředí SlideShow (menu Format>ScreenEnvironment>SlideShow). Není to však nutností.

Definice

obecné

boostm[β_]:={{Cosh[β],Sinh[β]},{Sinh[β],Cosh[β]}}

boosttr[β_][c_]:=boostm[β].c

boostobj[β_][o_List]:=boosttr[β]/@o

rotm[α_]:={{Cos[α],Sin[α]},{-Sin[α],Cos[α]}}

rottr[α_][c_]:=rotm[α].c

rotobj[α_][o_List]:=rottr[α]/@o

tooltip[s_][e_,l_]:=If[s,Tooltip[e,l],e]

garáž

contrat[pt_,β0_,γ_]:=Function[{p},boosttr[β0][pt+{p[[1]]γ,p[[2]]}]]

auto[pt_,β0_,γ_,xa_,va_]:={
{Black,Polygon[contrat[pt,β0,γ]/@CirclePoints[{-0.6xa,-0.8va},0.8va,9]],Polygon[contrat[pt,β0,γ]/@CirclePoints[{0.6xa,-0.8va},0.8va,9]]},
{Magenta,Polygon[contrat[pt,β0,γ]/@{{-xa,-va},{-xa,0},{-0.8xa,va},{0.2xa,va},{0.5xa,0},{xa,0},{xa,-va}}]}
}

Graphics[auto[{0,0},0,0.8,1,0.1]]

garaz[pt_,β0_,γ_,xg_,vg_]:={
{Blue,Polygon[contrat[pt,β0,γ]/@{{-xg,vg},{-(xg+vg),1.6vg},{xg ,1.2vg},{xg ,vg}}]},
{Opacity[0.5,Blue],Polygon[contrat[pt,β0,γ]/@{{-xg,vg},{-xg,-vg},{xg,-vg},{xg,vg}}]}
}

Graphics[garaz[{0,0},0,0.8,1,0.1]]

Garáž a dlouhé auto

Jakožto bohatí fyzici jsme si koupili dloooouhé auto. Bohužel nám pak zbyly prostředky pouze na krátkou garáž. Přátelé se nám tak smějí, že se nám auto do garáže nevejde.

Znalí STR se však vsadíme, že auto do garáže dostaneme: v jeden okamžik bude auto uvnitř garáže a oboje (přední i zadní) vrata garáže budou současně zavřené.  Máme šanci tuto vyhrát?

Samozřejmě! Podle STR se pohybujcí auto zkrátí a do garáže se nám vejde.

Co však uvidíme, pokud budeme sedět v autě a garáž se bude pohybovat vůči nám?

Garáž a dlouhé auto

With[{xg=1,xa=1.2,xbox=5.5,tbox=6,tmax=10,δx=1,δt=0.5,va=0.14,vg=0.16},
Manipulate[
GraphicsGrid[{{
Graphics[{
{
{Lighter[Blue,0.8],EdgeForm[],
Polygon[boostobj[β0][{{-xg,-tmax},{-xg,tmax},{xg,tmax},{xg,-tmax}}]]
},
{Blue,Thickness[Medium],
Line[boostobj[β0][{{-xg,-tmax},{-xg,tmax}}]],
Line[boostobj[β0][{{xg,-tmax},{xg,tmax}}]]
},
{Blue,Thickness[Large],
Line[boostobj[β0][{{-xg,-((xg-(xa/(Cosh[β])))/(Tanh[β]))},{-xg,((xg-(xa/(Cosh[β])))/(Tanh[β]))}}]],
Line[boostobj[β0][{{xg,-((xg-(xa/(Cosh[β])))/(Tanh[β]))},{xg,((xg-(xa/(Cosh[β])))/(Tanh[β]))}}]]
},
(*{Blue,Line[boostobj[β0][{{ta Tanh[β]-(xa/(Cosh[β]))-δx,ta},{ta Tanh[β]+(xa/(Cosh[β]))+δx,ta}}]]},*)
(*{Magenta,Line[boostobj[β0+β][{{-xa-((δx)/2),((ta )/(Cosh[β]))},{xa+((δx)/2),((ta )/(Cosh[β]))}}]]},*)
(*{Magenta,Thickness[0.015],Line[boostobj[β0][{{ta Tanh[β]-(xa/(Cosh[β])),ta},{ta Tanh[β]+(xa/(Cosh[β])),ta}}]]},*)
If[showtg,
{Magenta,Line[boostobj[β0+β][{{-xbox,tg },{xbox,tg }}]]},
{Blue,Line[boostobj[β0][{{-xbox,ta},{xbox,ta}}]]}
],
{Opacity[0.4,Lighter[Magenta,0.8]],EdgeForm[],
Polygon[boostobj[β0+β][{{-xa,-tmax},{-xa,tmax},{xa,tmax},{xa,-tmax}}]]
},
{Magenta,Thickness[Medium],
Line[boostobj[β0+β][{{-xa,-tmax},{-xa,tmax}}]],
Line[boostobj[β0+β][{{xa,-tmax},{xa,tmax}}]]
},
Which[
lc=="ne",If[showtg,
If[showbst,{auto[{0,tg},β0+β,1,xa,va],garaz[{-tg Tanh[β],tg },β0+β,(1/(Cosh[β])),xg,vg]},{}],
{auto[{ta Tanh[β],ta},β0,(1/(Cosh[β])),xa,va],garaz[{0,ta},β0,1,xg,vg]}
],
lc=="garáž",If[showtg,
{
{White,EdgeForm[],Polygon[Join[Plus[boosttr[β0+β][{-tg Tanh[β],tg }],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}},{{4xbox,tmax},{-4xbox,tmax}}]]},
{Red,Line[Plus[boosttr[β0+β][{-tg Tanh[β],tg }],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}}]},
If[True,garaz[boosttr[β][{-tg Tanh[β],tg }],β0,1,xg,vg],{}]
},
{
{White,EdgeForm[],Polygon[Join[Plus[boosttr[β0][{0,ta}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}},{{4xbox,tmax},{-4xbox,tmax}}]]},
{Red,Line[Plus[boosttr[β0][{0,ta}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}}]},
garaz[{0,ta},β0,1,xg,vg]
}
],
lc=="auto",If[showtg,
{
{White,EdgeForm[],Polygon[Join[Plus[boosttr[β0+β][{0,tg}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}},{{4xbox,tmax},{-4xbox,tmax}}]]},
{Red,Line[Plus[boosttr[β0+β][{0,tg}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}}]},
If[True,auto[boosttr[β][{0,tg}],β0,(1/(Cosh[β])),xa,va],{}]
},
{
{White,EdgeForm[],Polygon[Join[Plus[boosttr[β0][{ta Tanh[β],ta}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}},{{4xbox,tmax},{-4xbox,tmax}}]]},
{Red,Line[Plus[boosttr[β0][{ta Tanh[β],ta}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}}]},
auto[{ta Tanh[β],ta},β0,(1/(Cosh[β])),xa,va]
}
]
]
}
},PlotRange->{{-xbox,xbox},{-tbox,tbox}}],
Graphics[{
{
{Lighter[Blue,0.8],EdgeForm[],
Polygon[boostobj[β0-β][{{-xg,-tmax},{-xg,tmax},{xg,tmax},{xg,-tmax}}]]
},
{Blue,Thickness[Medium],
Line[boostobj[β0-β][{{-xg,-tmax},{-xg,tmax}}]],
Line[boostobj[β0-β][{{xg,-tmax},{xg,tmax}}]]
},
{Blue,Thickness[Large],
Line[boostobj[β0-β][{{-xg,-((xg-(xa/(Cosh[β])))/(Tanh[β]))},{-xg,((xg-(xa/(Cosh[β])))/(Tanh[β]))}}]],
Line[boostobj[β0-β][{{xg,-((xg-(xa/(Cosh[β])))/(Tanh[β]))},{xg,((xg-(xa/(Cosh[β])))/(Tanh[β]))}}]]
},
(*{Magenta,Line[boostobj[β0][{{-tg Tanh[β]-(xg/(Cosh[β]))-δx,tg},{-tg Tanh[β]+(xg/(Cosh[β]))+δx,tg}}]]},*)
(*{Blue,Thickness[0.015],Line[boostobj[β0][{{-tg Tanh[β]-(xg/(Cosh[β])),tg },{-tg Tanh[β]+(xg/(Cosh[β])),tg }}]]},*)
(*{Blue,Line[boostobj[β0-β][{{-xg-((δx)/2),((tg )/(Cosh[β]))},{xg+((δx)/2),((tg )/(Cosh[β]))}}]]},*)
If[showta,
{Blue,Line[boostobj[β0-β][{{-xbox,ta },{xbox,ta }}]]},
{Magenta,Line[boostobj[β0][{{-xbox,tg},{xbox,tg}}]]}],
{Opacity[0.4,Lighter[Magenta,0.8]],EdgeForm[],
Polygon[boostobj[β0][{{-xa,-tmax},{-xa,tmax},{xa,tmax},{xa,-tmax}}]]
},
{Magenta,Thickness[Medium],
Line[boostobj[β0][{{-xa,-tmax},{-xa,tmax}}]],
Line[boostobj[β0][{{xa,-tmax},{xa,tmax}}]]
},
Which[
lc=="ne",If[showta,
If[showbst,{auto[{ta Tanh[β],ta},β0-β,(1/(Cosh[β])),xa,va],garaz[{0,ta},β0-β,1,xg,vg]},{}],
{auto[{0,tg},β0,1,xa,va],garaz[{-tg Tanh[β],tg },β0,(1/(Cosh[β])),xg,vg]}
],
lc=="garáž",If[showta,
{
{White,EdgeForm[],Polygon[Join[Plus[boosttr[β0-β][{0,ta}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}},{{4xbox,tmax},{-4xbox,tmax}}]]},
{Red,Line[Plus[boosttr[β0-β][{0,ta}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}}]},
If[True,garaz[boosttr[-β][{0,ta}],β0,(1/(Cosh[β])),xg,vg],{}]
},
{
{White,EdgeForm[],Polygon[Join[Plus[boosttr[β0][{-tg Tanh[β],tg }],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}},{{4xbox,tmax},{-4xbox,tmax}}]]},
{Red,Line[Plus[boosttr[β0][{-tg Tanh[β],tg }],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}}]},
garaz[{-tg Tanh[β],tg },β0,(1/(Cosh[β])),xg,vg]
}
],
lc=="auto",If[showta,
{
{White,EdgeForm[],Polygon[Join[Plus[boosttr[β0-β][{ta Tanh[β],ta}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}},{{4xbox,tmax},{-4xbox,tmax}}]]},
{Red,Line[Plus[boosttr[β0-β][{ta Tanh[β],ta}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}}]},
If[True,auto[boosttr[-β][{ta Tanh[β],ta}],β0,1,xa,va],{}]
},
{
{White,EdgeForm[],Polygon[Join[Plus[boosttr[β0][{0,tg}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}},{{4xbox,tmax},{-4xbox,tmax}}]]},
{Red,Line[Plus[boosttr[β0][{0,tg}],#]&/@{4{-xbox,-xbox},{0,0},4{xbox,-xbox}}]},
auto[{0,tg},β0,1,xa,va]
}
]
]
}
},PlotRange->{{-xbox,xbox},{-tbox,tbox}}]
}},ImageSize->1000],
Dynamic@Grid[{
{
Item[Row[{
tooltip[showtt][Control[{{β,ArcCosh[(xa/xg)]+0.45},ArcCosh[(xa/xg)],3ArcCosh[(xa/xg)],ImageSize->60}],"rapidita (rychlost) auta vůči garáži"],Spacer[30],
tooltip[showtt][Control[{{β0,0,"(Subscript[β, o])"},-4,4,ImageSize->60}],"rapidita soustav vůči diagramu"],
tooltip[showtt][Control[{{β0,0,""},{-β->"-",0->"0",β->"+"},SetterBar,ImageSize->{60,24}}],"nastaví rapiditu soustav vůči diagramu tak, aby alespoň jedna soustava byla v klidu"],Spacer[30],
tooltip[showtt][Control[{{showbst,False,"detaily"},{True,False}}],"zobrazovat vizualizaci auta a garáže na linii současnosti i pro pohybující se soustavu"],Spacer[30],
tooltip[showtt][Control[{{lc,"ne","sv.kuž."},{"ne","auto","garáž"},PopupMenu,ImageSize->{64,24}}],"zobrazovat pouze kauzální minulost auta nebo garáže"],Spacer[200],
tooltip[showtt][Button["Návod",CreateDialog[DynamicModule[{},
Column[{
Style["Dlouhé auto v krátké garáži",Bold,Large],
,
"Animace zobrazuje průjezd auta garáží, jejíž klidová délka je menší než klidová délka auta.",
"Při dostatečně vysoké rychlosti se však auto relativisticky zkrátí a mělo by se do krátké garáže vejít.",
"Garáž má přední a zadní vrata. Ty jsou nastavena tak, aby se zavřela v okamžik, kdy auto je v garáži.",
"Po určitý časový úsek (z hlediska garáže) tak bude auto zavřené uvnitř garáže.",,
"Jak se však tato situace jeví z hlediska auta? V soustavě auta se přece relativisticky zkrátí garáž!",
"Řešení paradoxu spočívá v různosti pojmu současnosti klidových soustav garáže a auta.",,
"Situaci si lze ozřejmit porovnáním prostoročasových diagramů spojených s oběma soustavami.",
"Levé okno zobrazuje diagram soustavy garáže, pravé okno diagram soustavy auta.",
"V diagramech jsou zobrazeny světotrubice garáže (modrá) a auta (červená).",
"Okrajové linie světotrubice garáže odpovídají světočárám předních a zadních vrat.",
"Zvýrazněné části těchto světočar naznačují, kdy jsou příslušná vrata garáže zavřena.",
"V diagramech si je možné zobrazit linii současnosti jak soustavy garáže, tak auta a nahlédnout tak,",
"v jakém smyslu je auto schované v garáži.",,
Row[{"Nejprve je potřeba upřesnit mechanismus zavírání vrat. Přední vrata se zavřou v ",
Button["okamžik",{ta,tg}={-((xg-(xa/(Cosh[β])))/(Tanh[β])),((xa-(xg/(Cosh[β])))/(Tanh[β]))},Appearance->"FramedPalette" ],
", kdy je mine"}],
Row[{"zadek auta. Současně (z hlediska garáže) se ",
Button["zavřou",{ta,tg}={-((xg-(xa/(Cosh[β])))/(Tanh[β])),-((Cosh[β] xg-xa)/(Tanh[β]))-Sinh[β]xg},Appearance->"FramedPalette" ],
" i zadní vrata. Zadní vrata se ",
Button["otevřou",{ta,tg}={((xg-(xa/(Cosh[β])))/(Tanh[β])),-((xa-(xg/(Cosh[β])))/(Tanh[β]))},Appearance->"FramedPalette" ],
", když se k nim"}],
Row[{"přiblíží předek auta. Současně (z hlediska garáže) se ",
Button["otevřou",{ta,tg}={((xg-(xa/(Cosh[β])))/(Tanh[β])),((Cosh[β]xg-xa)/(Tanh[β]))+Sinh[β]xg},Appearance->"FramedPalette" ],
" i přední vrata."}],
Row[{"V soustavě garáže je tak auto vskutku po určitý čas ",
Button["zavřeno",{ta,tg}={0,0},Appearance->"FramedPalette" ],
" uvnitř garáže."}],,
Row[{"V soustavě auta se však garáž 'navléká' na auto a v žádném okamžiku nejsou současně zavřené přední"}],
Row[{"i zadní vrata. Z hlediska auta se nejdříve ",
Button["zavřou",{ta,tg}={-((xg-(xa/(Cosh[β])))/(Tanh[β])),-((Cosh[β] xg-xa)/(Tanh[β]))-Sinh[β]xg},Appearance->"FramedPalette" ],
" a ",
Button["otevřou",{ta,tg}={((xg-(xa/(Cosh[β])))/(Tanh[β])),-((xa-(xg/(Cosh[β])))/(Tanh[β]))},Appearance->"FramedPalette" ],
" zadní vrata a až pak se ",
Button["zavřou",{ta,tg}={-((xg-(xa/(Cosh[β])))/(Tanh[β])),((xa-(xg/(Cosh[β])))/(Tanh[β]))},Appearance->"FramedPalette" ],
" a ",
Button["otevřou",{ta,tg}={((xg-(xa/(Cosh[β])))/(Tanh[β])),((Cosh[β]xg-xa)/(Tanh[β]))+Sinh[β]xg},Appearance->"FramedPalette" ]
}],
Row[{
"přední vrata."}],,
Row[{"Pomocí táhel (Subscript[t, garáž]) ",Slider[Dynamic[ta],{-tmax,tmax},ImageSize->Small]," a (Subscript[t, auto]) ",Slider[Dynamic[tg],{-tmax,tmax},ImageSize->Small]," lze pohybovat linií současnosti příslušné"}],
"soustavy. Význačné okamžiky lze zvolit pomocí tlačítek pod táhly.",
"Všimněme si, že pořadí některých událostí se v soustavě garáže a auta liší - jedná se o prostorupodobně",
"položené události, jejichž pořadí záleží na volbě soustavy.",
Row[{"Boxík ",Checkbox[Dynamic[showta]]," vedle táhla (Subscript[t, garáž]) zapne zobrazování linie současnosti soustavy garáže i v pravém okně."}],
Row[{"Obdobně boxík ",Checkbox[Dynamic[showtg]]," vedle táhla (Subscript[t, auto]) zapne zobrazování linie současnosti soustavy auta v levém okně."}],
Row[{"Na těchto liniích se defaultně nezobrazuje ikona garáže a auta. Zobrazení lze zapnout boxíkem ",Style["detaily ",Italic],Checkbox[Dynamic[showbst]],"."}],
Row[{"Konečně, pomocí menu ",Style["sv.kuž. ",Italic],PopupMenu[Dynamic[lc],{"ne","auto","garáž"},ImageSize->{72,24}]," lze zapnout zobrazování pouze kauzální minulosti auta či"}],
"garáže. Zobrazuje se tak pouze oblast prostoročasu známá v daný okamžik pozorovateli v garáži či autě.",
},ItemSize->54,ItemStyle->{LineIndent->0}],InheritScope->True]]],"Zobrazí průvodce animací v samostatném okně."],
Spacer[10],
Tooltip[Control[{{showtt,True,"?"},{True,False}}],"Zobrazovat vysvětlivky při najetí myši na ovládací prvek."]
}],Alignment->Center],
SpanFromLeft
},
{
Row[{
tooltip[showtt][Control[{{ta,-tbox+δt,"(Subscript[t, garáž])"},-tmax,tmax}],"čas linie současnosti klidové soustavy garáže"],
tooltip[showtt][Control[{{showta,False,""},{True,False}}],"v pravém okně se bude zobrazovat linie současnosti garáže\n    (vizualizace auta a garáže pomocí volby 'detaily')"]
}],
Row[{
tooltip[showtt][Control[{{tg,-tbox+δt,"(Subscript[t, auto])"},-tmax,tmax}],"čas linie současnosti klidové soustavy auta"],
tooltip[showtt][Control[{{showtg,False,""},{True,False}}],"v levém okně se bude zobrazovat linie současnosti auta\n    (vizualizace auta a garáže pomocí volby 'detaily')"]
}]
},
{
tooltip[showtt][SetterBar[Dynamic[ta,({ta,tg}=#)&],{
{-tbox+δt,-tbox+δt}->"-∞",
{-((xg+(xa/(Cosh[β])))/(Tanh[β])),-((xa+(xg/(Cosh[β])))/(Tanh[β]))}->"vjezd",
{-((xg-(xa/(Cosh[β])))/(Tanh[β])),((xa-(xg/(Cosh[β])))/(Tanh[β]))}->"zavř.",
{0,0}->"střed",
{((xg-(xa/(Cosh[β])))/(Tanh[β])),-((xa-(xg/(Cosh[β])))/(Tanh[β]))}->"otev.",
{((xg+(xa/(Cosh[β])))/(Tanh[β])),((xa+(xg/(Cosh[β])))/(Tanh[β]))}->"výjezd",
{tbox-δt,tbox-δt}->"+∞"
}],"sekvence důležitých okamžiků při interpretaci z hlediska soustavy garáže"],
tooltip[showtt][SetterBar[Dynamic[ta,({ta,tg}=#)&],{
{-tbox+δt,-tbox+δt}->"-∞",
{-((xg+(xa/(Cosh[β])))/(Tanh[β])),-((xa+(xg/(Cosh[β])))/(Tanh[β]))}->"vjezd",
{-((xg-(xa/(Cosh[β])))/(Tanh[β])),-((Cosh[β] xg-xa)/(Tanh[β]))-Sinh[β]xg}->"Z zavř.",
{((xg-(xa/(Cosh[β])))/(Tanh[β])),-((xa-(xg/(Cosh[β])))/(Tanh[β]))}->"Z otev.",
{0,0}->"střed",
{-((xg-(xa/(Cosh[β])))/(Tanh[β])),((xa-(xg/(Cosh[β])))/(Tanh[β]))}->"P zavř.",
{((xg-(xa/(Cosh[β])))/(Tanh[β])),((Cosh[β]xg-xa)/(Tanh[β]))+Sinh[β]xg}->"P otev.",
{((xg+(xa/(Cosh[β])))/(Tanh[β])),((xa+(xg/(Cosh[β])))/(Tanh[β]))}->"výjezd",
{tbox-δt,tbox-δt}->"+∞"
}],"sekvence důležitých okamžiků při interpretaci z hlediska soustavy auta"]
}
},Spacings->{{40,40,40},{0,2,1,2}},Dividers->{{1->White,3->White},{1->White,2->Lighter[Gray],4->White}},ItemSize->30,Frame->True]
,Alignment->Center
]]